home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue44 / Paradox / DBCheckU.pas next >
Encoding:
Pascal/Delphi Source File  |  1999-03-03  |  7.9 KB  |  273 lines
  1. unit DBCheckU;
  2.  
  3. {$ifdef Ver80} { Delphi 1.0x }
  4.   {$define DelphiLessThan4}
  5. {$endif}
  6. {$ifdef Ver90} { Delphi 2.0x }
  7.   {$define DelphiLessThan4}
  8. {$endif}
  9. {$ifdef Ver100} { Delphi 3.0x }
  10.   {$define DelphiLessThan4}
  11. {$endif}
  12.  
  13. interface
  14.  
  15. procedure CheckOKForParadoxAppToRun;
  16.  
  17. implementation
  18.  
  19. uses
  20. {$ifdef Win32}
  21.   Registry,
  22. {$else}
  23.   IniFiles,
  24. {$endif}
  25.   DbiProcs, DbiTypes, DbiErrs, DB, DBTables, Forms, SysUtils, Classes, Dialogs,
  26.   Winprocs, WinTypes;
  27.  
  28. const
  29.   RebootRequired: Boolean = False;
  30.  
  31. procedure CheckLocalShare;
  32. var
  33.   ASYSConfig: SYSConfig;
  34. begin
  35. {$ifdef Win32}
  36.   { Ensure BDE is initialised }
  37.   Session.Open;
  38. {$endif}
  39.   if (DbiGetSysConfig(ASYSConfig) = DbiErr_None) and
  40.      not ASYSConfig.bLocalShare then
  41.   begin
  42.     ShowMessage('BDE''s LOCAL SHARE flag must be TRUE for this ' +
  43.       'program to run. Ask your System Administrator to do this for ' +
  44.       'you.'#13#13'This program will not continue until this change ' +
  45.       'has been made and all BDE applications have been restarted');
  46.   {$ifdef Win32}
  47.     Application.ShowMainForm := False;
  48.   {$endif}
  49.     Application.Terminate;
  50.   end
  51. end;
  52.  
  53. {$ifdef Win32}
  54. function RestartDialog(Wnd: HWnd; Reason: PChar; Flags: Integer): Integer; stdcall;
  55. external 'shell32.dll' index 59;
  56.  
  57. type
  58.   TVersionNo = record
  59.     MS, LS: Cardinal;
  60.   end;
  61.  
  62. function VersionNumber(const FileName: String): TVersionNo;
  63. var
  64.   VerInfo: Pointer;
  65.   Len, BufSize: {$ifdef DelphiLessThan4}Integer{$else}Cardinal{$endif};
  66.   Dest: PVSFixedFileInfo;
  67. begin
  68.   FillChar(Result, SizeOf(Result), 0);
  69.   //How big is version info?
  70.   BufSize := GetFileVersionInfoSize(PChar(FileName), Len);
  71.   if BufSize > 0 then
  72.   begin
  73.     //Reserve sufficient memory
  74.     GetMem(VerInfo, BufSize);
  75.     try
  76.       //Get version information
  77.       if GetFileVersionInfo(PChar(FileName), 0, BufSize, VerInfo) then
  78.         //Get translation table
  79.         if VerQueryValue(VerInfo, '\', Pointer(Dest), Len) then
  80.           with Dest^ do
  81.           begin
  82.             Result.MS := dwFileVersionMS;
  83.             Result.LS := dwFileVersionLS
  84.           end
  85.     finally
  86.       //Free sufficient memory
  87.       FreeMem(VerInfo, BufSize)
  88.     end
  89.   end
  90. end;
  91.  
  92. procedure CheckRedirector;
  93.  
  94.   procedure CheckFile(const FileName, Vn: String; Hi, Lo: Cardinal);
  95.   var
  96.     Ver: TVersionNo;
  97.   const
  98.     ErrorA = 'You need a newer system file. %s is version %d.%d.%d.';
  99.     ErrorB = ' It should be version %s.'#13#13'Get an update to this file from ' +
  100.              'http://support.microsoft.com/download/support/mslfiles/vrdrupd.exe';
  101.     Error1 = ErrorA + ErrorB;
  102.     Error2 = ErrorA + '%d.' + ErrorB;
  103.   begin
  104.     Ver := VersionNumber(FileName);
  105.     if (Ver.MS < Hi) or ((Ver.MS = Hi) and (Ver.LS < Lo)) then
  106.       //If the high word of the low DWord of the version info is 0,
  107.       //the 0 is never written in MS version info strings
  108.       if HiWord(Ver.LS) = 0 then
  109.         ShowMessage(Format(Error1, [FileName, HiWord(Ver.MS),
  110.           LoWord(Ver.MS), LoWord(Ver.LS), Vn]))
  111.       else
  112.         ShowMessage(Format(Error2, [FileName, HiWord(Ver.MS),
  113.           LoWord(Ver.MS), HiWord(Ver.LS), LoWord(Ver.LS), Vn]))
  114.   end;
  115.  
  116. var
  117.   Dir: array[0..255] of Char;
  118. begin
  119.   GetSystemDirectory(Dir, SizeOf(Dir));
  120.   CheckFile(String(Dir) + '\VREDIR.VXD', '4.0.1116', $40000, 1116);
  121.   CheckFile(String(Dir) + '\VNETSUP.VXD', '4.0.1112', $40000, 1112);
  122. end;
  123.  
  124. procedure CheckRegistryEntry(Reg: TRegistry;
  125.   const Path, Value: String;
  126.   const Default, Desired: Variant; Size: Byte);
  127. var
  128.   TmpInt: Cardinal;
  129.   TmpStr: String;
  130. begin
  131.   with Reg do
  132.     if OpenKey(Path, True) then
  133.       try
  134.         case VarType(Desired) of
  135.           varInteger:
  136.             { Some numbers need to be stored as DWORD values, }
  137.             { while some need to be stored as binary values }
  138.             if Size = 0 then
  139.             begin
  140.               if not ValueExists(Value) or
  141.                  (ReadInteger(Value) = Default) then
  142.               begin
  143.                 WriteInteger(Value, Desired);
  144.                 RebootRequired := True
  145.               end
  146.             end
  147.             else
  148.             begin
  149.               TmpInt := Default;
  150.               if ValueExists(Value) then
  151.                 ReadBinaryData(Value, TmpInt, Size);
  152.               if TmpInt = Default then
  153.               begin
  154.                 TmpInt := Desired;
  155.                 WriteBinaryData(Value, TmpInt, Size);
  156.                 RebootRequired := True
  157.               end
  158.             end;
  159.           varString:
  160.             begin
  161.               if not ValueExists(Value) or
  162.                  (ReadString(Value) = Default) then
  163.               begin
  164.                 WriteString(Value, Desired);
  165.                 RebootRequired := True
  166.               end
  167.             end
  168.         end
  169.       finally
  170.         CloseKey
  171.       end
  172. end;
  173.  
  174. const
  175.   Control  = 'System\CurrentControlSet\Control\';
  176.   Services = 'System\CurrentControlSet\Services\';
  177.  
  178. procedure CheckWin95Registry;
  179. var
  180.   Reg: TRegistry;
  181. const
  182.   DOSRequester = 'Network\Novell\System Config\Netware Dos Requester';
  183. begin
  184.   Reg := TRegistry.Create;
  185.   try
  186.     Reg.RootKey := HKey_Local_Machine;
  187.     //Fix VREDIR.VxD settings
  188.     CheckRegistryEntry(Reg, Services + 'VxD\VREDIR', 'DiscardCacheOnOpen', 0, 1, SizeOf(Byte));
  189.     //Fix NWREDIR.VxD settings
  190.     CheckRegistryEntry(Reg, Services + 'VxD\NWREDIR', 'ReadCaching', 1, 0, SizeOf(Byte));
  191.     //Fix Novell settings
  192.     CheckRegistryEntry(Reg, DOSRequester, 'Cache Writes', 'Yes', 'No', 0);
  193.     CheckRegistryEntry(Reg, DOSRequester, 'Opportunistic Locking', 'Yes', 'No', 0);
  194.     //Fix FileSystem troubleshooting settings
  195.     CheckRegistryEntry(Reg, Control + 'FileSystem', 'DriveWriteBehind', $FFFFFFFF, 0, SizeOf(Longint));
  196.     {$define AllOptionsThatPeopleSuggest}
  197.     {$ifdef AllOptionsThatPeopleSuggest}
  198.     CheckRegistryEntry(Reg, Control + 'FileSystem', 'SoftCompatMode', 1, 0, SizeOf(Longint));
  199.     CheckRegistryEntry(Reg, Control + 'FileSystem', 'AsyncFileCommit', 0, 1, SizeOf(Byte));
  200.     {$endif}
  201.   finally
  202.     Reg.Free
  203.   end
  204. end;
  205.  
  206. procedure CheckWinNTRegistry;
  207. var
  208.   Reg: TRegistry;
  209. begin
  210.   Reg := TRegistry.Create;
  211.   try
  212.     Reg.RootKey := HKey_Local_Machine;
  213.     //Disable opportunistic locking & caching
  214.     CheckRegistryEntry(Reg, Services + 'LanmanServer\Parameters', 'EnableOpLocks', 1, 0, 0);
  215.     CheckRegistryEntry(Reg, Services + 'LanmanServer\Parameters', 'CachedOpenLimit', 1, 0, 0);
  216.     CheckRegistryEntry(Reg, Services + 'LanmanWorkStation\Parameters', 'UseOpportunisticLocking', 1, 0, 0);
  217.     CheckRegistryEntry(Reg, Services + 'LanmanWorkStation\Parameters', 'UtilizeNtCaching', 1, 0, 0);
  218.     //Make sure NetWare popups are enabled to avoid a documented issue
  219.     CheckRegistryEntry(Reg, Services + 'NWCWorkstation\Parameters', 'DisablePopup', 1, 0, 0);
  220.   finally
  221.     Reg.Free
  222.   end
  223. end;
  224. {$else}
  225. procedure CheckWin31Registry;
  226. begin
  227.   with TIniFile.Create('System.Ini') do
  228.     try
  229.       if ReadString('386Enh', 'ForceLazyOff', '') = '' then
  230.       begin
  231.         { You need to put appropriate value for data drive letters!!! }
  232.         WriteString('386Enh', 'ForceLazyOff', 'CDE');
  233.         RebootRequired := True
  234.       end
  235.     finally
  236.       Free
  237.     end
  238. end;
  239. {$endif}
  240.  
  241. procedure CheckRegistryIsAcceptable;
  242. begin
  243. {$ifdef Win32}
  244.   case Win32Platform of
  245.     VER_PLATFORM_WIN32_WINDOWS: CheckWin95Registry;
  246.     VER_PLATFORM_WIN32_NT:      CheckWinNTRegistry;
  247.   end;
  248.   if RebootRequired then
  249.     //Use standard Win32 reboot dialog
  250.     RestartDialog(0, nil, ew_RestartWindows)
  251. {$else}
  252.   CheckWin31Registry;
  253.   if RebootRequired then
  254.   begin
  255.     ShowMessage('Some system settings have been changed - Windows needs to restart');
  256.     ExitWindows(ew_RestartWindows, 0)
  257.   end
  258. {$endif}
  259. end;
  260.  
  261. procedure CheckOKForParadoxAppToRun;
  262. begin
  263.   {$ifdef Win32}
  264.   //Only Win95 redirector files need checking
  265.   if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
  266.     CheckRedirector;
  267.   {$endif}
  268.   CheckRegistryIsAcceptable;
  269.   CheckLocalShare;
  270. end;
  271.  
  272. end.
  273.